home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / encode.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-20  |  2KB  |  68 lines
  1.  
  2. {$i-,v-}
  3.  
  4. program encode;
  5. { Convert (xfered) textfile back to original, by Bas van Gaalen, Holland, PD }
  6. type
  7.   buftype = array[0..1023] of byte;
  8.   str3 = string[3];
  9.   str80 = string[80];
  10.  
  11. var
  12.   infile : text;
  13.   outfile : file;
  14.   buffer : buftype;
  15.   infilename,outfilename,tmpstr : str80;
  16.   bufpos : word;
  17.   i,v : byte;
  18.  
  19. {----------}
  20.  
  21. procedure error(errstr : str80); begin
  22.   writeln(errstr); halt; end;
  23.  
  24. {----------}
  25.  
  26. function tobyte(inbyte : str3) : byte;
  27. const hexchars : array[0..15] of char = '0123456789ABCDEF';
  28. var i,tmpbyte : byte;
  29. begin
  30.   i := 0; while hexchars[i] <> upcase(inbyte[2]) do inc(i);
  31.   tmpbyte := i;
  32.   i := 0; while hexchars[i] <> upcase(inbyte[1]) do inc(i);
  33.   tmpbyte := tmpbyte+16*i;
  34.   tobyte := tmpbyte;
  35. end;
  36.  
  37. {----------}
  38.  
  39. begin
  40.   write(' Enter input filename: '); readln(infilename);
  41.   assign(infile,infilename);
  42.   reset(infile);
  43.   if ioresult <> 0 then error('Error opening file '+infilename);
  44.  
  45.   readln(infile,outfilename);
  46.   assign(outfile,outfilename);
  47.   rewrite(outfile,1);
  48.   if ioresult <> 0 then error('Error creating file '+outfilename);
  49.  
  50.   bufpos := 0;
  51.   repeat
  52.     readln(infile,tmpstr);
  53.     while length(tmpstr) > 0 do begin
  54.       buffer[bufpos] := tobyte(copy(tmpstr,1,2));
  55.       delete(tmpstr,1,2);
  56.       inc(bufpos);
  57.       if bufpos = sizeof(buffer) then begin
  58.         blockwrite(outfile,buffer,bufpos);
  59.         bufpos := 0;
  60.       end;
  61.     end;
  62.   until eof(infile);
  63.   blockwrite(outfile,buffer,bufpos);
  64.  
  65.   close(infile); close(outfile);
  66.   writeln('ready...');
  67. end.
  68.